(in-package #:org.shirakumo.fraf.trial.examples)

(define-example convex-physics
  :title "Convex Physics Scenes"
  :description "Allows you to load arbitrary scenes and shoot balls around to showcase the automated convex decomposition and collision detection."
  :superclasses (trial:physics-scene alloy:observable)
  :slots ((model :initform NIL :accessor model)
          (mesh :initform NIL :accessor mesh)
          (file :initform NIL :accessor file)
          (physics-system :initform (make-instance 'debug-rigidbody-system :units-per-metre 0.1)))
  (enter (make-instance 'vertex-entity :vertex-array (// 'trial 'grid)) scene)
  (enter (make-instance 'editor-camera :location (VEC3 0.0 2.3 10) :fov 50 :move-speed 0.1) scene)
  (enter (make-instance 'physics-wall :name :wall) scene)
  (enter (make-instance 'directional-light :direction -vy3+) scene)
  (enter (make-instance 'ambient-light :color (vec3 0.2)) scene)
  (enter (make-instance 'gravity :gravity (vec 0 -10 0)) scene)
  (let ((render (make-instance 'pbr-render-pass))
        (map (make-instance 'ward)))
    (connect (port render 'color) (port map 'previous-pass) scene)))

(define-handler ((scene convex-physics-scene) mouse-press :after) (button)
  (when (eq button :left)
    (let ((ball (make-instance 'physics-sphere :location (location (camera scene))))
          (force (m*4/3 (minv (view-matrix)) (vec 0 2 -100))))
      (nv+ (velocity ball) force)
      (enter-and-load ball scene +main+))))

(alloy:define-observable (setf model) (value alloy:observable))
(alloy:define-observable (setf mesh) (value alloy:observable))

(defmethod setup-ui ((scene convex-physics-scene) panel)
  (let ((layout (make-instance 'alloy:grid-layout :col-sizes '(120 140 T) :row-sizes '(30)))
        (focus (make-instance 'alloy:vertical-focus-list)))
    (alloy:enter "Load Model" layout :row 0 :col 0)
    (let ((button (alloy:represent "..." 'alloy:button :layout-parent layout :focus-parent focus)))
      (alloy:on alloy:activate (button)
        (let ((file (org.shirakumo.file-select:existing :title "Load Model File..."
                                                        :filter '(("Model file" "obj" "gltf" "glb"))
                                                        :default (file scene))))
          (when file (setf (file scene) file)))))
    (alloy:enter "Mesh" layout :row 1 :col 0)
    (let ((selector (alloy:represent (mesh scene) 'alloy:combo-set :value-set () :layout-parent layout :focus-parent focus)))
      (alloy:on model (model scene)
        (let ((meshes (if (typep model 'model) (list-meshes model) ())))
          (setf (alloy:value-set selector) meshes)
          (when meshes (setf (alloy:value selector) (first meshes)))))
      (alloy:on alloy:value (mesh selector)
        (setf (mesh scene) mesh)))
    (alloy:enter "Scale" layout :row 2 :col 0)
    (let* ((wall (node :wall scene))
           (size (alloy:represent (scaling wall) T :layout-parent layout :focus-parent focus)))
      (alloy:on alloy:value (value size)
        (setf (physics-primitives wall) (physics-primitives wall))))
    (alloy:finish-structure panel layout focus)))

(defmethod (setf file) :before (file (scene convex-physics-scene))
  (setf (model scene) (generate-resources 'model-loader file)))

(defmethod (setf mesh) :before ((mesh mesh-data) (scene convex-physics-scene))
  (let ((wall (node :wall scene)))
    (setf (vertex-array wall) (make-vertex-array mesh NIL))
    (setf (physics-primitives wall) mesh))
  (commit (scene +main+) (loader +main+)))
